home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
mapl0831.zip
/
ANSICHAT.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-08-30
|
14KB
|
323 lines
' $title: 'ANSIChat Split Screen Chat for RBBS-PC v17.4'
' By Dan Drinnon 8:903/2 1:313/6
' The Cellar Door RBBS (505) 763-1795 9600 v32
' Scott McNay 1:395/11
' The Wizard II RBBS (817) 554-5331 9600 V32b, V42b
'
' Copyright (c) 1992 by Daniel T. Drinnon All Rights Reserved
'
' DO NOT Distribute in Modified Form!
'
'REVISIONS:
'1.00 - 06-28-92 Initial Release
'1.01 - 06-29-92 Fix for F2 Shell to DOS from ANSICHAT
'1.02 - 07-04-92 Prevent F10 from Loading another ANSIChat
' Keep ANSIChat from showing 'RBBS' if that is already
' part of the BBS name.
' added support for Sysop's PgUp/PgDn (RBBSSUB3.BAS)
' combined local and remote input routines
'1.03 - 07-09-92 Greater control over ANSI colors independent of RBBS colors
'1.04 - 07-13-92 Added control to keep ANSICHAT from popping up when
' the sysop does not have ANSI installed according to
' CONFIG.
'1.05 - 07-19-92 Modified RBBSSUB3 to get status of ANSIChat Capability
' in DRSTx.DEF after return from a DOOR.
' Removed redundant code in RBBS-PC.BAS.
' Included ANSIFUN - a mod to make a Ring instead of a BEEP
' for Sysop Page.
'1.06 - 07-04-92 Gave the remote the option to terminate the chat by
' pressing ESC.
'1.07 - 08-10-92 Fixed BackSpace routine to properly locate the cursor.
'1.08 - 08-13-92 Fixed the wordwrap/color mix problem and tweaked the
' ANSI commands and a couple other things to speed up
' the I/O.
'1.09 - 08-18-92 Changed the bottom line of the remote screen to not go
' past line 23.
' Changed ZIP distribution file name to ACHATxxx.ZIP where xxx
' denotes the version number.
'1.10 - 08-26-92 Removed "STATIC" from SUB headers to force string space to
' be released after use.
' Added GetUserScreenSize sub to determine user's screen size
' so that screen layout can be determined dynamically. Makes
' ANSIChat more compatible with non-standard (25x80) screens.
' Changed exit method to require ESC key to be pressed twice.
' This is compatible with ANSIED, and prevents accidents when
' user hits a cursor key.
'
' $INCLUDE: 'RBBS-VAR.MOD'
'
' $SUBTITLE: 'ANSIChat - ANSI Split Screen Chat Routine'
'
' $PAGE
'
' SUBROUTINE NAME -- ANSIChat
'
' INPUT PARAMETERS -- None
'
' OUTPUT PARAMETERS -- None
'
' SUBROUTINE PURPOSE -- Allows Split Screen ANSI Chat for RBBS
'
'
DIM ANSIRow(1), ANSICol(1), ACColor$(1), HoldInput$(1), StartRow(1)
DIM MaxRow(1), WasX$(1), LastChar$(1) ' 1.10
Common Shared ANSIRow(), ANSICol(), ACColor$(), HoldInput$(), StartRow()
Common Shared MaxRow(), WasX$(), LastChar$() ' 1.10
Common Shared LocalOut, RemoteOut, SideOut
Common Shared MenuColor1$, MenuColor2$
Common Shared RowMax, ColMax, RowMid ' 1.10
'
1000 SUB ANSIChat
'
LocalOut = 0
RemoteOut = 1
SideOut = LocalOut
TimeChatStarted! = TIMER ' 1.10
CALL GetUserScreenSize ' 1.10
ANSIRow(LocalOut) = 2
ANSIRow(RemoteOut) = RowMid + 2 ' 1.10
ANSICol(LocalOut) = 1
ANSICol(RemoteOut) = 1
ACColor$(LocalOut) = "32;40m" ' 1.08
ACColor$(RemoteOut) = "33;40m" ' 1.08
ZWasCM = ZTrue
ZSubParm = 1
HoldColorReset$ = ZColorReset$
MenuColor1$ = "33;44m" ' 1.08
MenuColor2$ = "36;44m" ' 1.08
ZColorReset$ = MenuColor2$ ' 1.03
CALL ANSIMenu
CALL ANSILocate (ANSIRow(LocalOut),ANSICol(LocalOut))
CALL QuickTPut1 (ACColor$(LocalOut) + ZSysopGreeting$)
CALL SplitScreenChat
ZWasCM = 0
CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
ZSecsPerSession! = ZSecsPerSession! + Elapsed!
IF NOT ZLocalUser THEN _
ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
CALL ClearANSIScreen
CALL QuickTPut(ZEmphasizeOff$ + ZCrLF$ + _ ' 1.08
"Chat over. BBS resuming",1) ' 1.08
ZColorReset$ = HoldColorReset$
END SUB
'
4000 SUB ANSIMenu
'
LineBar$ = STRING$(80,177) ' 1.08
CALL ClearANSIScreen
CALL ANSILocate (1,1)
CALL QuickTPut (MenuColor2$ + LineBar$,0) ' 1.03
IF INSTR(ZRBBSName$,"BBS") <> 0 THEN _ ' 1.02
ZOutTxt$ = "░*>>> " + ZRBBSName$ + " ANSI Chat <<<*░" _ ' 1.02
ELSE _ ' 1.02
ZOutTxt$ = "░*>>> " + ZRBBSName$ + " RBBS ANSI Chat <<<*░" ' 1.02
temppos = (40 - (LEN(ZOutTxt$)/2))
CALL ANSILocate (1,temppos)
CALL QuickTPut (MenuColor1$ + ZOutTxt$,0) ' 1.03
CALL ANSILocate (RowMid + 1,1) ' 1.10
CALL QuickTPut (MenuColor2$ + LineBar$,0) ' 1.03
CALL ANSILocate (RowMid + 1,3) ' 1.10
CALL QuickTPut (MenuColor2$ + "░" + ZSysopFirstName$ + _ ' 1.03
" " + ZSysopLastName$ + "░",0) ' 1.03
CALL ANSILocate (RowMid + 1,43) ' 1.10
CALL QuickTPut (MenuColor2$ + "░" + ZActiveUserName$ + "░",0) ' 1.03
CALL Line25
END SUB
'
5000 SUB ClearANSIScreen
'
CALL QuickTPut ("",0) ' 1.03
ZSubParm = 2
CALL Line25
ZSubParm = 0
CALL ANSILocate (1,1)
END SUB
'
6000 SUB ANSILocate (ANSIRow,ANSICol)
'
CALL QuickTPut ("" + MID$(STR$(ANSIRow),2) + ";" + _
MID$(STR$(ANSICol),2) + "H",0)
END SUB
'
8000 SUB SplitScreenChat
'
8001 HoldInput$(LocalOut) = "" ' 1.01
HoldInput$(RemoteOut) = ""
MaxLen = ColMax - 2 ' 1.10
StartRow(LocalOut) = 2
StartRow(RemoteOut) = RowMid + 2 ' 1.10
MaxRow(LocalOut) = RowMid ' 1.10
MaxRow(RemoteOut) = RowMax ' 1.10
ANSICol(LocalOut) = 1
ANSICol(RemoteOut) = 1
ANSIRow(LocalOut) = StartRow(LocalOut) + 1
ANSIRow(RemoteOut) = StartRow(RemoteOut)
WasX$(LocalOut) = ""
WasX$(RemoteOut) = ""
ZWaitExpired = ZFalse
'
8010 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
CALL Carrier
IF ZSubParm < 0 THEN _
EXIT SUB
'
8020 CALL FindFKey
IF ZWasCM = 0 THEN _ ' 1.01
CALL FlushCom (ZCommPortStack$) : _ ' 1.01
ZKeyPressed$ = "" : _ ' 1.01
CALL ANSIMenu : _ ' 1.01
ZWasCM = ZTrue : _ ' 1.01
GOTO 8001 ' 1.01
SideOut = LocalOut
WasX$(LocalOut) = ZKeyPressed$
IF ZKeyPressed$ = ZEscape$ THEN _
EXIT SUB
IF WasX$(LocalOut) <> "" THEN _
GOTO 8060
'
8030 IF ZLocalUser THEN _
GOTO 8010
SideOut = RemoteOut
IF ZCommPortStack$ <> "" THEN _
WasX$(RemoteOut) = LEFT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
GOTO 9000
CALL EofComm (Char)
IF Char <> -1 THEN _
GOTO 8050 _
ELSE _
GOTO 8010
'
8050 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
CALL GetCom (WasX$(RemoteOut))
'
8060 'Control keys
LastChar$(SideOut) = RIGHT$(LastChar$(SideOut),1) + _ ' 1.10
WasX$(SideOut) ' 1.10
IF WasX$(SideOut) = CHR$(8) THEN _
GOTO 8500 _
ELSE IF WasX$(SideOut) = CHR$(9) THEN _
GOTO 8510 _
ELSE IF WasX$(SideOut) = CHR$(13) THEN _
GOTO 8520
GOTO 9000
'
8500 'BackSpace
IF HoldInput$(SideOut) <> "" THEN _ ' 1.07
HoldInput$(SideOut) = LEFT$(HoldInput$(SideOut), _ ' 1.07
LEN(HoldInput$(SideOut))-1) ' 1.07
IF ANSICol(SideOut) > 1 THEN _
ANSICol(SideOut) = ANSICol(SideOut) - 1 : _ ' 1.07
GOTO 8501 ' 1.07
IF ANSICol(SideOut) = 1 THEN _ ' 1.07
GOSUB 8502 : _ ' 1.07
ANSICol(SideOut) = MaxLen - 1 : _ ' 1.07
ANSIRow(SideOut) = ANSIRow(SideOut) - 1 ' 1.03
IF ANSIRow(SideOut) < StartRow(SideOut) THEN _ ' 1.07
ANSIRow(SideOut) = MaxRow(SideOut) ' 1.07
8501 GOSUB 8502 ' 1.07
GOTO 8010
8502 CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut)) ' 1.07
IF NOT ZLocalUser THEN _ ' 1.07
CALL PutCom (" ") ' 1.07
CALL LPrnt (" ",0) ' 1.07
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut)) ' 1.07
RETURN ' 1.07
'
8510 'TAB
HoldInput$(SideOut) = ""
IF ANSICol(SideOut) + 5 > MaxLen THEN _
CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) _
ELSE _
ANSICol(SideOut) = ANSICol(SideOut) + 5 : _
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
GOTO 8010
'
8520 'CR
HoldInput$(SideOut) = ""
CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
GOTO 8010
'
9000 'Character Placement
IF LastChar$(SideOut) = ZEscape$ + ZEscape$ THEN _ ' 1.10
EXIT SUB
HoldInput$(SideOut) = HoldInput$(SideOut) + WasX$(SideOut)
IF WasX$(SideOut) = " " THEN _
HoldInput$(SideOut) = ""
IF ANSICol(SideOut) = MaxLen AND WasX$(SideOut) <> " " THEN _
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut) - _
LEN(HoldInput$(SideOut))) : _
CALL QuickTput(ACColor$(SideOut) + "", 0) : _ ' 1.08
CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) : _
CALL QuickTPut (HoldInput$(SideOut),0) : _
ANSICol(SideOut) = ANSICol(SideOut) + LEN(HoldInput$(SideOut)) - 1 : _
WasX$(SideOut) = "" : _
HoldInput$(SideOut) = ""
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
IF NOT ZLocalUser THEN _
CALL PutCom (ACColor$(SideOut) + WasX$(SideOut))
CALL LPrnt (ACColor$(SideOut) + WasX$(SideOut),0)
ANSICol(SideOut) = ANSICol(SideOut) + 1
IF ANSICol(SideOut) > MaxLen THEN _
CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
WasX$(SideOut) = ""
GOTO 8010
END SUB
'
10000 SUB AddRow (StartRow,MaxRow)
'
ANSICol(SideOut) = 1
ANSIRow(SideOut) = ANSIRow(SideOut) + 1
IF ANSIRow(SideOut) > MaxRow THEN _
ANSIRow(SideOut) = StartRow
IF ANSIRow(SideOut) < MaxRow THEN _
CALL ANSILocate (ANSIRow(SideOut) + 1,ANSICol(SideOut)) : _
CALL QuickTput("", 0)
IF ANSIRow(SideOut) = MaxRow THEN _
CALL ANSILocate (StartRow,ANSICol(SideOut)) : _
CALL QuickTput("", 0)
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
END SUB
'
11000 SUB GetUserScreenSize ' 1.10
'
ColMax = 80
RowMax = 24
RowMid = RowMax \ 2
IF ZLocalUser THEN _
EXIT SUB
CALL FlushCom (Strng$)
CALL PutCom ("CCBn")
CALL GetUserCursorLoc (RowMax, ColMax)
IF ColMax > 80 THEN _
ColMax = 80
IF RowMax > 24 THEN _
RowMax = 24
RowMid = RowMax \ 2
END SUB
'
11100 SUB GetUserCursorLoc (Row, Col) ' 1.10
'
Call ReadString ("R",ZTestANSITime,Response$)
Temp = INSTR(Response$,"")
IF Temp > 0 THEN _
SemiPtr =INSTR(Temp,Response$,";") : _
IF (SemiPtr > 0) THEN _
Temp2 = INSTR(SemiPtr,Response$,"R") : _
IF (Temp2 > 0) THEN _
Row = VAL(MID$(Response$,Temp+2,SemiPtr-1)) : _
Col = VAL(MID$(Response$,SemiPtr+1,Temp2-1))
END SUB
'
11200 SUB ReadString (Wait$, DelayTime,Response$) ' 1.10
'
Response$ = ""
TempElapsed! = 0
Delay! = TIMER
WHILE (INSTR(Strng$,Wait$) = 0) AND (TempElapsed < DelayTime)
CALL FlushCom (Strng$)
Response$ = Response$ + Strng$
CALL CheckTime (Delay!, TempElapsed!, 2)
WEND
END SUB